home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / CYCLOID.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-28  |  5.7 KB  |  198 lines

  1. VERSION 4.00
  2. Begin VB.Form CycloidForm 
  3.    Caption         =   "Cycloid"
  4.    ClientHeight    =   5310
  5.    ClientLeft      =   2085
  6.    ClientTop       =   900
  7.    ClientWidth     =   4830
  8.    Height          =   6000
  9.    Left            =   2025
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   354
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   322
  14.    Top             =   270
  15.    Width           =   4950
  16.    Begin VB.TextBox RText 
  17.       Height          =   285
  18.       Left            =   3285
  19.       TabIndex        =   8
  20.       Text            =   "15"
  21.       Top             =   45
  22.       Width           =   615
  23.    End
  24.    Begin VB.TextBox PText 
  25.       Height          =   285
  26.       Left            =   1320
  27.       TabIndex        =   5
  28.       Text            =   "20"
  29.       Top             =   45
  30.       Width           =   615
  31.    End
  32.    Begin VB.TextBox QText 
  33.       Height          =   285
  34.       Left            =   2280
  35.       TabIndex        =   4
  36.       Text            =   "7"
  37.       Top             =   45
  38.       Width           =   615
  39.    End
  40.    Begin VB.TextBox DtText 
  41.       Height          =   285
  42.       Left            =   240
  43.       TabIndex        =   3
  44.       Text            =   "0.025"
  45.       Top             =   45
  46.       Width           =   615
  47.    End
  48.    Begin VB.CommandButton CmdGo 
  49.       Caption         =   "Go"
  50.       Default         =   -1  'True
  51.       Height          =   375
  52.       Left            =   4200
  53.       TabIndex        =   1
  54.       Top             =   0
  55.       Width           =   615
  56.    End
  57.    Begin VB.PictureBox Canvas 
  58.       AutoRedraw      =   -1  'True
  59.       Height          =   4815
  60.       Left            =   0
  61.       ScaleHeight     =   -2.2
  62.       ScaleLeft       =   -1.1
  63.       ScaleMode       =   0  'User
  64.       ScaleTop        =   1.1
  65.       ScaleWidth      =   2.2
  66.       TabIndex        =   0
  67.       Top             =   480
  68.       Width           =   4815
  69.    End
  70.    Begin VB.Label Label1 
  71.       Caption         =   "R"
  72.       Height          =   255
  73.       Index           =   0
  74.       Left            =   3120
  75.       TabIndex        =   9
  76.       Top             =   60
  77.       Width           =   255
  78.    End
  79.    Begin VB.Label Label1 
  80.       Caption         =   "P"
  81.       Height          =   255
  82.       Index           =   3
  83.       Left            =   1200
  84.       TabIndex        =   7
  85.       Top             =   60
  86.       Width           =   255
  87.    End
  88.    Begin VB.Label Label1 
  89.       Caption         =   "Q"
  90.       Height          =   255
  91.       Index           =   2
  92.       Left            =   2115
  93.       TabIndex        =   6
  94.       Top             =   60
  95.       Width           =   255
  96.    End
  97.    Begin VB.Label Label1 
  98.       Caption         =   "dt"
  99.       Height          =   255
  100.       Index           =   1
  101.       Left            =   0
  102.       TabIndex        =   2
  103.       Top             =   60
  104.       Width           =   255
  105.    End
  106.    Begin VB.Menu mnuFile 
  107.       Caption         =   "&File"
  108.       Begin VB.Menu mnuFileExit 
  109.          Caption         =   "E&xit"
  110.       End
  111.    End
  112. Attribute VB_Name = "CycloidForm"
  113. Attribute VB_Creatable = False
  114. Attribute VB_Exposed = False
  115. Option Explicit
  116. Const PI = 3.14159
  117. Const TWO_PI = 2 * PI
  118. Dim P As Integer
  119. Dim Q As Integer
  120. Dim R As Integer
  121. Dim P_Q As Single
  122. Dim PQ As Integer
  123. Dim PQR As Integer
  124. ' ************************************************
  125. ' Draw the curve on the indicated picture box.
  126. ' ************************************************
  127. Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, Dt As Single)
  128. Dim t As Single
  129.     pic.Cls
  130.     pic.CurrentX = X(start_t)
  131.     pic.CurrentY = Y(start_t)
  132.     t = start_t + Dt
  133.     Do While t < stop_t
  134.         pic.Line -(X(t), Y(t))
  135.         t = t + Dt
  136.     Loop
  137.     pic.Line -(X(stop_t), Y(stop_t))
  138. End Sub
  139. ' ************************************************
  140. ' Non-recursively compute the greatest common
  141. ' divisor of to integers.
  142. ' ************************************************
  143. Private Function GCD(ByVal a As Integer, ByVal b As Integer) As Integer
  144. Dim B_Mod_A As Integer
  145.     B_Mod_A = b Mod a
  146.     Do While B_Mod_A <> 0
  147.         ' Prepare the arguments for the "recursion."
  148.         b = a
  149.         a = B_Mod_A
  150.         B_Mod_A = b Mod a
  151.     Loop
  152.     GCD = a
  153. End Function
  154. ' ************************************************
  155. ' Calculate the values t must cross to draw a
  156. ' cycloid.
  157. ' ************************************************
  158. Sub SetTBounds(tmin As Single, tmax As Single)
  159.     tmin = 0
  160.     ' LCM / P * 2 * PI.
  161.     tmax = Q / GCD(P, Q) * TWO_PI
  162. End Sub
  163. ' ************************************************
  164. ' Find the least common multiple of two integers.
  165. ' ************************************************
  166. Function LCM(a As Integer, b As Integer) As Integer
  167.     LCM = a * b / GCD(a, b)
  168. End Function
  169. ' ************************************************
  170. ' The parametric function Y(t).
  171. ' ************************************************
  172. Function Y(t As Single) As Single
  173.     Y = (PQ * Sin(t) + R * Sin(t * P_Q)) / PQR
  174. End Function
  175. ' ************************************************
  176. ' The parametric function X(t).
  177. ' ************************************************
  178. Function X(t As Single) As Single
  179.     X = (PQ * Cos(t) + R * Cos(t * P_Q)) / (PQR)
  180. End Function
  181. Private Sub CmdGo_Click()
  182. Dim tmin As Single
  183. Dim tmax As Single
  184. Dim Dt As Single
  185.     P = CInt(PText.Text)
  186.     Q = CInt(QText.Text)
  187.     R = CInt(RText.Text)
  188.     P_Q = P / Q
  189.     PQ = P + Q
  190.     PQR = PQ + R
  191.     SetTBounds tmin, tmax
  192.     Dt = CSng(DtText.Text)
  193.     DrawCurve Canvas, tmin, tmax, Dt
  194. End Sub
  195. Private Sub mnuFileExit_Click()
  196.     Unload Me
  197. End Sub
  198.